##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## .default = col_double(),
## Team = col_character(),
## Player = col_character(),
## College = col_character(),
## Player_URL = col_character(),
## Img_URL = col_character(),
## HS = col_character()
## )
## ℹ Use `spec()` for the full column specifications.
##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## player = col_character(),
## college = col_character(),
## Team = col_character(),
## Year = col_double(),
## Player_URL = col_character(),
## HS = col_character()
## )
#build prelim college network
draft_college <- draft %>%
select(College, Player)
college_graph <- graph_from_data_frame(draft_college, directed = FALSE)
college_ntwrk <- ggnetwork(college_graph)
ggplot(data = college_ntwrk
, aes(x = x, y = y, xend = xend, yend = yend)) +
geom_edges(color = "grey50") +
geom_nodes() +
# geom_nodelabel(aes(label = name)) +
theme_blank()
diameter(college_graph)
## [1] 4
vcount(college_graph)
## [1] 831
ecount(college_graph)
## [1] 693
####HOW CONNECTED NBA TEAMS ARE
set.seed(2000)
#build prelim nba network
draft_nba <- players %>%
filter(Year == 2019) %>%
select(player, Team, Year)
# filter(Team == "BOS" )
nba_graph <- graph_from_data_frame(draft_nba, directed = FALSE)
nba_ntwrk <- ggnetwork(nba_graph)
ggplot(data = nba_ntwrk
, aes(x = x, y = y, xend = xend, yend = yend)) +
geom_edges( color = "green") +
geom_nodes() +
geom_nodelabel(aes(label = name)) +
theme_blank()
diameter(nba_graph)
## [1] 12
vcount(nba_graph)
## [1] 401
ecount(nba_graph)
## [1] 1496
#build prelim hs network
draft_hs <- draft %>%
# filter(Draft_Year > 2019) %>%
select(HS, Player, Pick)
hs_graph <- graph_from_data_frame(draft_hs, directed = FALSE)
hs_ntwrk <- ggnetwork(hs_graph)
ggplot(data = hs_ntwrk
, aes(x = x, y = y, xend = xend, yend = yend)) +
geom_edges(color = "green") +
geom_nodes() +
# geom_nodelabel(aes(label = name)) +
theme_blank()
diameter(hs_graph)
## [1] 2
vcount(hs_graph)
## [1] 1285
ecount(hs_graph)
## [1] 693
####NBA PLAYERS BY YR
set.seed(2001)
#build prelim nba network
draft_nba1 <- players %>%
select(player, Team, Year) %>%
filter(Year == "2010" )
nba_graph1 <- graph_from_data_frame(draft_nba1, directed = FALSE)
nba_ntwrk1 <- ggnetwork(nba_graph1)
ggplot(data = nba_ntwrk1
, aes(x = x, y = y, xend = xend, yend = yend)) +
geom_edges(arrow=arrow(type="closed", length=unit(6,"pt"))
, color = "lightgray") +
geom_nodes() +
geom_nodelabel(aes(label = name)) +
theme_blank()
diameter(nba_graph1)
## [1] 18
vcount(nba_graph1)
## [1] 329
ecount(nba_graph1)
## [1] 1269
set.seed(001)
draft_nba <- players %>%
select(player, Team, Year)
nba_graph <- graph_from_data_frame(draft_nba, directed = FALSE)
nba_ntwrk <- ggnetwork( nba_graph )
nba_ntwrk$tooltip <- paste0("Player = ", nba_ntwrk$name)
gg_point_1 <- ggplot(data = nba_ntwrk
, aes(x = x, y = y, xend = xend, yend = yend, tooltip = tooltip)) +
geom_edges(color = "grey50") +
geom_nodes(color = "orange", size = 4) +
theme_blank() +
# geom_nodetext(aes(label = name)) +
geom_point_interactive(size=2)
# htmlwidget call
ggiraph(code = {print(gg_point_1)})
set.seed(002)
hs <- players %>%
select(player, HS, Year)
hsg <- graph_from_data_frame(hs, directed = FALSE)
hsnet <- ggnetwork( hsg )
hsnet$tooltip <- paste0("Player = ", hsnet$name)
gg_point_2 <- ggplot(data = hsnet
, aes(x = x, y = y, xend = xend, yend = yend, tooltip = tooltip)) +
geom_edges(color = "green") +
geom_nodes(color = "red", size = 4) +
theme_blank() +
# geom_nodetext(aes(label = name)) +
geom_point_interactive(size=2)
# htmlwidget call
ggiraph(code = {print(gg_point_2)})
set.seed(0034)
c <- players %>%
select(player, college, Year)
collg <- graph_from_data_frame(c, directed = FALSE)
collnet <- ggnetwork( collg )
collnet$tooltip <- paste0("Player = ", collnet$name)
gg_point_3 <- ggplot(data = collnet
, aes(x = x, y = y, xend = xend, yend = yend, tooltip = tooltip)) +
geom_edges(color = "green") +
geom_nodes(color = "gold", size = 4) +
theme_blank() +
# geom_nodetext(aes(label = name)) +
geom_point_interactive(size=2)
# htmlwidget call
ggiraph(code = {print(gg_point_3)})
set.seed(0034)
nba10 <- players %>%
select(player, Team, Year) %>%
filter( Year == "2010")
nbag10 <- graph_from_data_frame(nba10, directed = TRUE)
nbanet10 <- ggnetwork( nbag10 )
nbanet10$tooltip <- paste0("Player = ", nbanet10$name)
gg10 <- ggplot(data = nbanet10
, aes(x = x, y = y, xend = xend, yend = yend, tooltip = tooltip)) +
geom_edges(color = "green") +
geom_nodes(color = "gold", size = 4) +
theme_blank() +
geom_nodetext(aes(label = name %in% TEAMS0), check_overlap = TRUE) +
geom_point_interactive(size=2) +
labs(
title = "2010 NBA Season Trades"
)
# htmlwidget call
# ggiraph(code = {print(gg_point_4)})
girafe(ggobj = gg10,
options = list(
opts_sizing(width = .7),
opts_hover_inv(css = "opacity:0.1;"),
opts_hover(css = "fill:red;"),
opts_toolbar(position = "bottomright") )
)
set.seed(0035)
nba11 <- players %>%
select(player, Team, Year) %>%
filter( Year == "2011")
nbag11 <- graph_from_data_frame(nba11, directed = TRUE)
nbanet11 <- ggnetwork( nbag11 )
nbanet11$tooltip <- paste0("Player = ", nbanet11$name)
gg11 <- ggplot(data = nbanet11
, aes(x = x, y = y, xend = xend, yend = yend, tooltip = tooltip)) +
geom_edges(color = "green") +
geom_nodes(color = "gold", size = 4) +
theme_blank() +
# geom_nodetext(aes(label = name)) +
geom_point_interactive(size=2) +
labs(
title = "2011 NBA Season Trades"
)
# htmlwidget call
# ggiraph(code = {print(gg_point_4)})
girafe(ggobj = gg11,
options = list(
opts_sizing(width = .7),
opts_hover_inv(css = "opacity:0.1;"),
opts_hover(css = "fill:red;"),
opts_toolbar(position = "bottomright") )
)
set.seed(0036)
nba12 <- players %>%
select(player, Team, Year) %>%
filter( Year == "2012")
nbag12 <- graph_from_data_frame(nba12, directed = TRUE)
nbanet12 <- ggnetwork( nbag12 )
nbanet12$tooltip <- paste0("Player = ", nbanet12$name)
gg12 <- ggplot(data = nbanet12
, aes(x = x, y = y, xend = xend, yend = yend, tooltip = tooltip)) +
geom_edges(color = "green") +
geom_nodes(color = "gold", size = 4) +
theme_blank() +
# geom_nodetext(aes(label = name)) +
geom_point_interactive(size=2) +
labs(
title = "2012 NBA Season Trades"
)
# htmlwidget call
# ggiraph(code = {print(gg_point_4)})
girafe(ggobj = gg12,
options = list(
opts_sizing(width = .7),
opts_hover_inv(css = "opacity:0.1;"),
opts_hover(css = "fill:red;"),
opts_toolbar(position = "bottomright") )
)
##SUCCESS
library(plotly)
get_data <- reactive({
event.data <- event_data("plotly_selected", source = "subset")
data <- draft %>% mutate(show_id = FALSE)
if (!is.null(event.data)) {
data$show_id[event.data$pointNumber + 1] <- TRUE
}
data
})
renderPlotly({
data <- get_data()
p <- ggplot(data, aes(x = Years, y = input$yaxchoices, size = Pick, key = Player)) +
geom_point(aes(color = "royalblue2"), position = "jitter") +
geom_text(data=subset(data, show_id),aes( Years, PTS, label= Player)
, position = position_jitter(width = 20,height = 20), show.legend = FALSE) +
labs(x = "Length of career", y = yax_choice_names[yax_choice_values == input$yaxchoices]
, title = paste0("Career ", yax_choice_names[yax_choice_values == input$yaxchoices])
, subtitle = paste0(input$plotyearvar, " Draft Class")
, size = (size_choice_names[size_choice_values == input$sizechoices])) +
guides(color = FALSE) +
theme( axis.title = element_text(face = "bold"))
ggplotly(p, source = "subset") %>% layout(dragmode = "select")
})
p
plot_ly( draft, x = ~Years, y = ~FGpct, type = "scatter", name = ~Player) %>%
layout(title = "Career Success - Field Goal %", showlegend = FALSE)
## No scatter mode specifed:
## Setting the mode to markers
## Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode